perm filename MODIFY[AP,SYS] blob
sn#051676 filedate 1973-06-30 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00030 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 DEFINITIONS
C00007 00003 STORAGE ALLOCATIONS
C00011 00004 MODIFY: RESET
C00013 00005 FINISH READING IN FILES. INITIALIZE STRUCTURES.
C00016 00006 NXTBOT: PUSHJ P,GETSRT get a keyword from WORDS.SRT
C00021 00007 COUNT NUMBER OF LINKS LOST BY DELETING THIS KEYWORD
C00024 00008 deleting part of an entry..a brother or son
C00027 00009 INSERTION OF A NEW KEYWORD
C00030 00010 INS7: MOVE DPTR,MULKY
C00032 00011 INSINS: MOVE PPTR,[POINT 7,PARTS,35] insert on something already moved
C00035 00012 INSFIN: MOVEI CHAR,CR now put in CRLF
C00038 00013 DUNFWD: MOVE B,DPTR
C00041 00014 insert something..either a brother or son
C00046 00015 WRITIN: MOVE C,A both C and A now point to the new word just insertedd
C00049 00016 NXTAT2: JUMPE CHAR,INSDUN finished
C00052 00017 GETMLT: MOVE WSORT,PARTS(CNT) SAVDIF expects this
C00054 00018 MOV1TM: MOVE LPTR,MPTR save MPTR
C00056 00019 MOVAGN: MOVE A,DICT2(DBOT) if -1, this entry was deleted. A table entry must be
C00059 00020 TABENT: MOVNM MPTR,TABLE(TPTR)make half of TABLE entry
C00063 00021 FIXING THE LINKS AND DICT FILES
C00065 00022 Now we update the automatic notification file's pointers into DICT
C00069 00023 CREATE THE TMP FILES
C00071 00024 WRITE OUT THE TMP FILES. ASK IF SHOULD CONTINUE
C00073 00025 DELETE THE OLD FILES PRIOR TO RENAMING THE NEW ONES
C00075 00026 RENAME THE TMP FILES TO STANDARD NAMES, THEN LEAVE.
C00078 00027 TEST3 MOV GETBYT ERROR
C00080 00028 GETSRT
C00083 00029 COUNTL
C00087 00030 GETDCT
C00090 ENDMK
C⊗;
;DEFINITIONS
TITLE MODIFY
TPTR←←1 ;pointer into TABLE to fix up LINKS and DICT
DPTR←2 ;usually the current word in DICT
DBOT←3 ;usually the current destination in DICT2
DIFP←←4 ;reg to hold a possibly different word for comparison
A←4 ;temporary reg
PPTR←←4 ;byte pointer into the PARTS
RPTR←5 ;retrieval pointer for MULKY
LINCNT←←6 ;ac to count links
CHAR←6 ;where the byte pointers load into
DIFNO←←7 ;difference between an entry's position in DICT and DICT2
KPTR←7 ;pointer into MULKY..always points to last word of multiple words
RECDIF←←7 ;record difference,if DICT2 needs to move the MULTS down
MPTR←←10 ;pointer into the MULT section of DICT
WPTR←10 ;pointer into WORDS
WSORT←11 ;ac to hold a SORTED word to compare with DIFP
INSPTR←←11 ;byte pointer into WORDS.INS
DELPTR←←11 ;byte pointer into WORDS.DEL
WBPTR←12 ;byte pointer into WORDS
B←13 ;temporary ac
TDIFP←←13 ;a temporary DIFP
CPTR←←14 ;pointer into old OCCUR.DAT
LPTR←14 ;pointer into LINKS
BPTR←←15 ;holds backpointer into DICT from LINKS
C←15 ;temporary ac
MAXW←←15 ;maximum length of the keywords
CBOT←←16 ;pointer into new OCCUR.DAT
CNT←16 ;link counter
P←17 ;stack
WLEN←←6400
DLEN←←6000
MLEN←←=256
MULMAX←←=10
CLEN←←DLEN/2
DELLEN←←=200
INSLEN←←=200
LLEN←←10000
PDLEN←←=400
CR←←15
LF←←12
DEFINE ERRMSG(MSG)
{PUSHJ P,[ MOVEM A,SAVEDA
MOVEI A,[ASCIZ \MSG\]
JRST ERROR]}
;STORAGE ALLOCATIONS
RENADR: 0
BLOCK 3
IBUF: BLOCK 3
NIBUF: BLOCK 3 ;INPUT BUFFER HEADER FOR NOTIF
NOBUF: BLOCK 3 ;OUTPUT BUFFER HEADER FOR NOTIF
NOTIFF: SIXBIT /NOTIF/ ;AUTOMATIC NOTIFICATION FILE OF REQUESTS
BLOCK 3
INSF: SIXBIT /WORDS/
SIXBIT /INS/
BLOCK 2
DELF: SIXBIT /WORDS/
SIXBIT /DEL/
BLOCK 2
LINKSF: SIXBIT /LINKS/
BLOCK 3
WORDSF: SIXBIT /WORDS/
BLOCK 3
DICTF: SIXBIT /DICT/
BLOCK 3
SORTF: SIXBIT /WORDS/
SIXBIT /SRT/
BLOCK 2
OCCURF: SIXBIT /OCCUR/
SIXBIT /DAT/
BLOCK 2
INDEXF: SIXBIT /INDEX/
BLOCK 3
OLPART: BLOCK 6 ;holds first word of previous SORTED word
OLMLKY: BLOCK 2 ;holds address of last DICT entry
MULKY: BLOCK MULMAX ;holds addresses for each of the current DICT multiple words
INS: BLOCK INSLEN ;WORDS.INS
DEL: BLOCK DELLEN ;WORDS.DEL
OCCUR: BLOCK CLEN ;old OCCUR.DAT
OCCUR2: BLOCK CLEN ;new OCCUR.DAT
LINKS: BLOCK LLEN
DICT: BLOCK DLEN ;old DICT
DICT2: BLOCK DLEN+200;new DICT
TABLE: BLOCK =400 ;TABLE for fixing the LINKS
PDLST: BLOCK PDLEN
WORDS: BLOCK WLEN
D2CMD: IOWD DLEN,DICT2
0
O2CMD: IOWD CLEN,OCCUR2
0
LCMD: IOWD LLEN,LINKS
0
INSCMD: IOWD INSLEN,INS
0
DELCMD: IOWD DELLEN,DEL
0
OCMD: IOWD CLEN,OCCUR
0
DCMD: IOWD 0,DICT
0
WCMD: IOWD WLEN,WORDS
0
DCBOTM: 0 ;end of DICT..place to add on MULTS
INSINF: 0 ;flag indicating we just inserted a relative MULT to the current word
MOVED: 0 ;already moved entry to DICT2
OCFLG: 0 ;flag indicating there is an OCCUR.DAT
STAINF: 0 ;flag indicating this is a "stationary insert"
OLMLFG: 0 ;flag indicating last (old) key was a MULT
MULFLG: 0 ;flag indicating this key is a MULT
LSTCNT: 0 ;number of similar PARTS in two MULTS for writing into WORDS
CBOTM: 0 ;storage for CBOT
DELPTM: 0 ;storage for DELPTR
DIFNOM: 0 ;storage for DIFNO
KPTRM: 0 ;storage for KPTR
STOR2: 0 ;temporary storage
STORAG: 0 ;temporary storage
INSPTM: 0 ;storage for INSPTR
MASK2: 374000000000
SAVEDA: 0
STRNG: BLOCK 2
TOTCNM: 0 ;total count number for counting links
SPACES: 100402010040
MASK: 7700000
PARTS: BLOCK =30 ;storage for current SORTED word
DSK17: 17
SIXBIT /DSK/
0
MODIFY: RESET
MOVE P,[IOWD PDLEN,PDLST] ;initialize push down list
MODIF: OPEN 0,DSK17
ERRMSG {OPEN FAILED ON DSK}
SETZM INDEXF+3
SETZM INDEXF+2
SETZM INDEXF+1
ENTER 0,INDEXF ;THIS ENTER "SETS" THE AP LOCK ON DATA FILES
JRST [RELEAS 0,
MOVEI A,1
SLEEP A,
JRST MODIF]
OPEN 1,DSK17 ;read in all of WORDS
ERRMSG {OPEN FAILED ON WORDS}
SETZM WORDSF+3
LOOKUP 1,WORDSF
ERRMSG {LOOKUP FAILED ON WORDS}
IN 1,WCMD
JRST .+2
ERRMSG {IN FAILED ON WORDS}
RELEAS 1,
INIT 2,0
SIXBIT /DSK/
IBUF
ERRMSG {INIT FAILED ON WORDS.SRT FIRST TIME}
SETZM SORTF+3
LOOKUP 2,SORTF
ERRMSG {LOOKUP FAILED ON WORDS.SRT}
OPEN 4,DSK17 ;read in the LINKS file
ERRMSG {OPEN FAILED ON LINKS}
SETZM LINKSF+1
LOOKUP 4,LINKSF
ERRMSG {LOOKUP FAILED ON LINKS}
IN 4,LCMD
JRST .+2
ERRMSG {IN FAILED ON LINKS}
RELEAS 4,
SETZM OCFLG
OPEN 10,DSK17
ERRMSG {OPEN FAILED ON OCCUR.DAT}
SETZM OCCURF+3
LOOKUP 10,OCCURF
JRST [SETOM OCFLG ;set flag indicating there is no OCCUR.DAT
JRST DCONT]
IN 10,OCMD
JRST .+2
ERRMSG {IN FAILED ON OCCUR.DAT}
DCONT: RELEAS 10,
;FINISH READING IN FILES. INITIALIZE STRUCTURES.
OPEN 3,DSK17 ;read in DICT
ERRMSG {OPEN FAILED ON DICT}
SETZM DICTF+3
LOOKUP 3,DICTF
ERRMSG {LOOKUP FAILED ON DICT}
HLLZ A,DICTF+3
HLLM A,DCMD
IN 3,DCMD
JRST .+2
ERRMSG {IN FAILED ON DICT}
RELEAS 3,
SETZ KPTR,
MOVEI DBOT,2 ;destination of new DICT
MOVEI CBOT,1 ;destination of new OCCUR.DAT
MOVEM CBOT,CBOTM
MOVEI A,DLEN ;find end of DICT
MOVE B,DICT(A)
JUMPN B,.+2
SOJA A,.-2
SUBI A,2
MOVEM A,DCBOTM
SETZM MULKY ;initialize ptr to current DICT word
SETZM MOVED ;indicate current DICT entry not yet moved to DICT2
SETZM TABLE ;set initial two entries to TABLE to catch
SETZM TABLE+1 ; the first entries, which remain in the same place
MOVEI TPTR,2 ;pointer into TABLE to fix pointers into DICT
MOVEI CPTR,1 ;pointer into old OCCUR.DAT
SETZB DPTR,DELPTM ;pointer into old DICT
MOVE A,[POINT 7,INS-1,35]
MOVEM A,INSPTM ;storage for pointer into WORDS.INS
MOVEI WBPTR,WLEN-1 ;find the first vacant word in WORDs by searching
SKIPN WORDS(WBPTR) ; back from the end of the file
SOJG WBPTR,.-1
ADD WBPTR,[POINT 7,WORDS,35];make a byte pointer into WORDS
PUSHJ P,GETSRT ;get rid of leading CRLF in WORDS.SRT
NXTBOT: PUSHJ P,GETSRT ;get a keyword from WORDS.SRT
NXTDCT: MOVEI CNT,1
SETZM INSINF
PUSHJ P,GETDCT ;get next old keyword from DICT
NXTMLT: MOVEM KPTR,MULFLG ;NOT MULT iff KPTR=0
MOVE DPTR,MULKY(RPTR);get ptr to current main DICT word
HLRZ WPTR,DICT(DPTR) ;get the DICT pointer into WORDS
MOVE DIFP,WORDS(WPTR);holds first part of word in WORDS
CAME DIFP,PARTS(CNT) ;same as first part of word in WORDS.SRT?
JRST SAVDF ;no, go save or delete the different word
CAMN DIFP,MASK2 ;are the same words a question mark?
JRST PREFIX ;yes...we're done
NXT2: ADDI WPTR,1
MOVE DIFP,WORDS(WPTR) ;get the next part from WORDS
ADDI CNT,1
CAMN DIFP,PARTS(CNT) ;same as next part in WORDS.SRT?
JRST NXT2 ;yes,continue
MOVE TDIFP,PARTS-1(CNT)
TRNE TDIFP,176 ;no, was end of last part an @?
JRST SAVDF ;no. Words are different. Go insert or delete
;words in DICT and WORDS.SRT match
ADDI CNT,1 ;get the next part
MOVE TDIFP,PARTS(CNT)
JUMPN TDIFP,GETMLT ;end of words are marked by a null word
HRRE TDIFP,DICT+1(DPTR);end of word..see if part matched so far is not
JUMPL TDIFP,STAINS ;a key because of a -1 in the field.
MOVE DPTR,MULKY ;get ptr to first word of current keyword
SKIPE OCFLG
JRST OC1 ;do following only if there is an OCCUR.DAT
MOVE A,OCCUR(CPTR) ;transfer one word of OCCUR.DAT
MOVE CBOT,CBOTM
MOVEM A,OCCUR2(CBOT)
ADDI CBOT,1 ;increment pointers
ADDI CPTR,1
MOVEM CBOT,CBOTM
OC1: MOVEM DBOT,OLMLKY ;save current DBOT
SETZM OLMLKY+1
SETZM OLMLFG
SKIPN MOVED ;move the slot to DICT2 if it isn't already there
PUSHJ P,MOV
JRST NXTBOT ;return and get two new words to compare
SAVDF: MOVE WSORT,PARTS(CNT);SAVDIF requires that WSORT have the first
SAVDIF: CAML DIFP,WSORT ;WORDS ARE DIFFERENT. WHICH COMES FIRST?
JRST INSERT ;WSORT (FROM WORDS.SRT). INSERT NEW KEYWORD
JRST DELET ;DIFP (FROM OLD DICT). DELETE OLD KEYWORD
;COUNT NUMBER OF LINKS LOST BY DELETING THIS KEYWORD
DELET: ADDI CPTR,1 ;delete this word from OCCUR.DAT
MOVE DPTR,MULKY(KPTR);get the pointer to the first word
SKIPN OLMLFG
SKIPE MULFLG
JRST DELMUL
MOVEM KPTR,KPTRM ;the simple case...deleting non-MULTS
MOVE DIFNO,DIFNOM
SUBI DIFNO,2 ;DICT2 entries after this will be moved two more..
MOVNM DPTR,TABLE(TPTR);so we store this information for the LINKS fixup
MOVEM DIFNO,TABLE+1(TPTR)
MOVE DELPTR,DELPTM ;get the pointer to WORDS.DEL
MOVEM DIFNO,DIFNOM
MOVE KPTR,KPTRM ;get the KPTR back
PUSHJ P,COUNTL ;count the number of links lost
ADDI TPTR,2 ;increment pointer into TABLE
SETZM OLMLFG
SKIPE OLMLKY+1
SETOM OLMLFG
JRST NXTDCT ;return and get the next DICT word
DELMUL: HRRE A,DICT+1(DPTR) ;see if this is a legal keyword
JUMPGE A,STADEL
HLRZ A,DICT+1(DPTR) ;it's not..get the next word in the MULT
JUMPN A,DELA
CAME DPTR,MULKY ;there is no next word..this is a null entry
JRST DELM4 ;it is not the first of the mults
MOVEM KPTR,KPTRM ;we are deleting a complete entry.
MOVE DIFNO,DIFNOM
SUBI DIFNO,2 ;DICT2 entries after this will be moved two more..
MOVNM DPTR,TABLE(TPTR);so we store this information for the LINKS fixup
MOVEM DIFNO,TABLE+1(TPTR)
MOVEM DIFNO,DIFNOM
ADDI TPTR,2
MOVE KPTR,KPTRM
SETZM MULFLG
SETZM OLMLFG ;see if previous entry was a MULT
SKIPE OLMLKY+1
SETOM OLMLFG
PUSHJ P,TEST3 ;test to see if we've moved a now invalid key
JRST NXTDCT ;return to beginning for next keywords
;deleting part of an entry..a brother or son
DELM4: HLRZ A,DICT+2(DPTR) ;get the backpointer
HRRZ CNT,DICT+2(DPTR);get the brother
HLRZ TDIFP,DICT+1(A) ;get the son of the backpointer
CAME TDIFP,DPTR ;the same?
JRST DELM3 ;no,pointed to byt the brother of the backpointer
HRLM CNT,DICT+1(A) ;yes..store the current brother
JUMPN CNT,DELM2 ;if non-null,skip this
SETOM DICT(DPTR) ;delete the current slot
MOVE DPTR,A ;decreas the backpointer
HRRE B,DICT+1(DPTR) ;is this a valid keyword?
JUMPL B,DELMUL ;no, and CNT could be zero.return possibly to delete again
PUSHJ P,TEST3 ;yes, so see if the DICT2 (moved) version is still valid
;deleting a brother
DELM3: HRRM CNT,DICT+2(A) ;get the brother of the current key
DELM2: HRLM A,DICT+2(CNT) ;make it the brother of the backpointer
SETOM DICT(DPTR) ;delete this entry
JRST NXTDCT ;return for the next DICT
DELA: MOVE DPTR,A ;get the next of word in this key
JRST DELMUL
;deleting a valid keyword by inserting a -1 in the links pointer
STADEL: MOVE DELPTR,DELPTM ;get the pointer to WORDS.DEL
PUSHJ P,COUNTL ;count the number of links lost
MOVEI A,-1
HRRM A,DICT+1(DPTR) ;set the flag indicating not a valid keyword
HLRZ A,DICT+1(DPTR) ;see if this key has a son
JUMPE A,DELMUL ;no..go back and erase this entry
JRST NXTDCT ;yes..the entry must stay. Start over with a new DICT word
;INSERTION OF A NEW KEYWORD
INSERT: SKIPE OCFLG
JRST OC2
MOVE CBOT,CBOTM ;increment CBOT indicating a keyword of count zero
SETZM OCCUR2(CBOT)
ADDI CBOT,1
MOVEM CBOT,CBOTM
OC2: SKIPN MULFLG
SKIPE OLMLFG
JRST INSMUL
;simple insertion of a non-MULT..maybe
MOVE A,DBOT ;get the last moved entry
SUBI A,2
HLRZ WPTR,DICT2(A) ;get the pointer to the first word of the last entry
SETZ CNT,
CKWRDT: MOVE WSORT,WORDS(WPTR);get the first word of the last entry
ADDI CNT,1
CAMN WSORT,PARTS(CNT);compare it with the current (inserted) word
AOJA WPTR,CKWRDT ;same,get next 5 char
SAMLTT: CAIN CNT,1 ;see if the first word was indeed the same
JRST SAMNO ;no
MOVE WSORT,WORDS-1(WPTR);maybe
TRNE WSORT,176
JRST SAMNO
SETOM MOVED ;yes
SETOM INSINF
SETOM OLMLFG
JRST INSINS
SAMNO: MOVEM DBOT,OLMLKY ;keep OLMLKY up to date
SETZM OLMLKY+1
SETZM DICT2+1(DBOT) ;wipe out the right half of the next slot
HRRZ A,WBPTR ;get the pointer to where the word will go
SUBI A,WORDS-1 ;make the pointer relative to WORDS
HRLZM A,DICT2(DBOT) ;store pointer into words in DICT
SETO A, ;make all insertions invalid until the last
HRRM A,DICT2+1(DBOT) ;word of the MULT is inserted
ADDI DBOT,2 ;increment DBOT
SETOM MOVED ;entry is in DICT2
INS7: MOVE DPTR,MULKY
MOVNM DPTR,TABLE(TPTR) ;store negative pointer to DICT in TABLE
MOVEM KPTR,KPTRM
MOVE DIFNO,DIFNOM
ADDI DIFNO,2 ;and the difference is getting smaller
MOVEM DIFNO,TABLE+1(TPTR) ;store for use in moving LINKS
MOVEM DIFNO,DIFNOM
MOVE KPTR,KPTRM
ADDI TPTR,2
MOVE PPTR,[POINT 7,PARTS,35] ;byte pointer into PARTS
ILDB CHAR,PPTR ;get a character from PARTS+1
MOVE INSPTR,INSPTM ;set up the byte pointer into WORDS.INS
CAIN CHAR,"@" ;end of word?
JRST DEP100 ;yes..prepare to dep100
DEPBYT: IDPB CHAR,WBPTR ;no, deposit the char and continue
IDPB CHAR,INSPTR ;deposit into WORDS.INS
ILDB CHAR,PPTR ;get next char
CAIE CHAR,"@" ;is it an @?
JRST DEPBYT ;no, continue
DEP100: IDPB CHAR,WBPTR ;yes,prepare to deposit @ signs
TLNE WBPTR,760000 ;finished with this word?
JRST DEP100 ;no
HRRZ B,WBPTR ;yes...see if we've run out of room in WORDS
SUBI B,WORDS
CAIL B,WLEN
ERRMSG {WORDS IS TOO SMALL}
HRRZ CNT,PPTR ;get the current PART number
SUBI CNT,PARTS-2 ;relative to PARTS+1
MOVEM CNT,LSTCNT ;this much is identical to the previous entry
JRST EATUM ;eat up the @'s
INSINS: MOVE PPTR,[POINT 7,PARTS,35] ;insert on something already moved
ILDB CHAR,PPTR ;get a char from PARTS
MOVE INSPTR,INSPTM ;get the pointer to WORDS.INS
INSIN3: IDPB CHAR,INSPTR ;deposit the char
ILDB CHAR,PPTR ;get another
CAIE CHAR,"@" ;end of word?
JRST INSIN3 ;no, repeat
EATUM: ILDB CHAR,PPTR ;yes.fill out the word with @'s
CAIN CHAR,"@"
JRST EATUM
JUMPE CHAR,INSFIN ;if it is zero we are done
SETOM OLMLKY+1 ;we have a multiple word
SETOM OLMLFG
SKIPE INSINF ;if we are inserting on a word already moved,go to DUNFWD
JRST DUNFWD
MOVE B,DBOT ;otherwise get the last word moved
SUBI B,2
MOVE C,DCBOTM ;get the next slot for insertion
ADDI C,3
MOVEM C,DCBOTM
HRLM C,DICT2+1(B) ;DICT2 of the last entry gets the new slot
JRST .+2
MLTIN2: HRLM C,DICT+1(B) ;B=OLD DICT POINTER TO MULT..,C= NEW POINTER
HRLM B,DICT+2(C) ;store the backpointer
MOVEI B," " ;put the space in WORDS.INS
IDPB B,INSPTR
MULTIN: HRRZ B,WBPTR ;check to see if there is still room in WORDS
SUBI B,WORDS-1
CAILE B,WLEN
ERRMSG {WORDS IS TOO SMALL}
HRLZM B,DICT(C) ;store pointer to words
SETO B, ;make all keywords invalid until the last one
HRRM B,DICT+1(C)
DEPMUL: IDPB CHAR,WBPTR ;deposit the chars until end of word
IDPB CHAR,INSPTR
ILDB CHAR,PPTR
CAIE CHAR,"@"
JRST DEPMUL
DEPA: IDPB CHAR,WBPTR ;finish out the word with @'s
TLNE WBPTR,760000
JRST DEPA
EATUM2: ILDB CHAR,PPTR ;eat the @'s from the parts
CAIN CHAR,"@"
JRST EATUM2
JUMPE CHAR,INSDUN ;finished if CHAR = 0
MOVE B,C ;not done. Get another available insert slot and repeat
MOVE C,DCBOTM
ADDI C,3
MOVEM C,DCBOTM
JRST MLTIN2
INSFIN: MOVEI CHAR,CR ;now put in CRLF
CHAN1: HLLZS DICT2-1(DBOT) ;make keyword valid by zeroing the -1
IDPB CHAR,INSPTR ;put CRLF in WORDS.INS
MOVEI CHAR,LF
IDPB CHAR,INSPTR
MOVEM INSPTR,INSPTM ;save INSPTR in memory
PUSHJ P,GETSRT ;get the next SORTED word
SETZ CNT, ;reset pointers and counters
SETZ RPTR,
SETOM OLMLFG
AOJA CNT,NXTMLT ;go back to compare new word to old DICT word
;STATIONARY INSERT CONSISTING OF ZEROING A -1 FLAG
STAINS: MOVEI A,=100 ;set A past all possible parts
MOVEM A,LSTCNT
MOVE CBOT,CBOTM ;increment CBOT indicating an insertion has been made
SETZM OCCUR2(CBOT)
ADDI CBOT,1
MOVEM CBOT,CBOTM
SETZ A,
HRRM A,DICT+1(DPTR) ;zero the -1, making this keyword valid
MOVE A,DPTR ;get the pointer to this word of the MULT
SETOM STAINF ;set the staionary insert flag
JRST WRITE2 ;write this word in WORDS.INS
INSMUL: SKIPE MULFLG ;check if should insert on the end of the prev mult
JRST INSCON
INSLST: MOVE DPTR,DBOT ;get the previous entry
SUBI DPTR,2
HLRZ WPTR,DICT2(DPTR);get the pointer to words
SETOM MOVED ;set various flags
SETZM OLMLFG
SETOM MULFLG
SETOM INSINF
SETZ CNT,
JRST CKWRD ;go see if they are the same
INSCON: MOVE DPTR,MULKY ;get the first word of the current DICT word
SETZ CNT,
HLRZ WPTR,DICT(DPTR) ;get the pointer into WORDS
CKWRD: MOVE WSORT,WORDS(WPTR);see if the words are identical
ADDI CNT,1
CAMN WSORT,PARTS(CNT)
AOJA WPTR,CKWRD
SAMMLT: CAIN CNT,1
JRST .+4 ;first words are not the same
MOVE WSORT,WORDS-1(WPTR)
TRNN WSORT,176
JRST DUNFWD
SKIPN MULFLG ;not the same..straight insertion required
SETZM MOVED
SETZM OLMLFG
SETZM MULFLG
JRST OC2
DUNFWD: MOVE B,DPTR
HLRZ A,DICT+1(DPTR) ;get the pointer to the son
SKIPE INSINF
HLRZ A,DICT2-1(DBOT)
SETZM INSINF
CAIN A,0
JRST INS1SN ;no son..go insert the first son
ADDI CNT,1
CKWRD3: HLRZ WPTR,DICT(A) ;see if the son also matches the current (inserted)word
MOVEM CNT,LSTCNT ;they are the same up to this point
CKWRD2: MOVE WSORT,WORDS(WPTR)
CAME WSORT,PARTS(CNT)
JRST GETBRO ;not the same but maybe the brother matches
ADDI CNT,1
ADDI WPTR,1
CKWRD4: MOVE WSORT,WORDS(WPTR);compare the next parts as above
CAME WSORT,PARTS(CNT)
JRST DIFRNT ;not the same
ADDI CNT,1
AOJA WPTR,CKWRD4
DIFRNT: MOVE WSORT,WORDS-1(WPTR);see if the last word ends in @
TRNN WSORT,176
AOJA CNT,GETSON ;it does, get the next son and repeat
GETBRO: MOVE WSORT,WORDS(WPTR)
CAME WSORT,PARTS(CNT);finish examining this word as far as they are equal
JRST GETB2
ADDI WPTR,1
AOJA CNT,GETBRO
GETB2: CAML WSORT,PARTS(CNT);see if we really should get the next brother
JRST INSSOM ;or really insert a new one right here
MOVE B,A ;B holds the last word tried
HRRZ A,DICT+2(A) ;A gets the brother pointer
JUMPE A,INSBRO ;if null, insert a brother
MOVE CNT,LSTCNT ;set CNT to last identical part
JRST CKWRD3 ;return
GETSON: MOVEM CNT,LSTCNT ;words identical up to this point
MOVE DPTR,A ;DPTR is the last father
MOVE B,A ;B is the last brother
HLRZ A,DICT+1(DPTR) ;A gets the son pointer
JUMPE A,INSSON ;if null, go insert a son
JRST CKWRD3
;insert something..either a brother or son
INSSOM: HLRZ C,DICT+2(A) ;get the backpointer
CAML C,MULKY ;see if it has been moved already
JRST INSS2
HLRZ C,DICT2+1(C)
JRST INS1SN
INSS2: HLRZ C,DICT+1(C) ;get the son pointer
CAMN C,A ;see if it points to the current word
JRST INSSON ;it does..insert a son
INSBRO: HRRZ DPTR,DICT+2(B) ;DPTR← brother of last word
MOVE A,DCBOTM ;A←new slot for inserted word
ADDI A,3
MOVEM A,DCBOTM
HRRM A,DICT+2(B) ;last word now points to inserted word
HRLM B,DICT+2(A) ;inserted word now points back to last bro
JUMPE DPTR,WRITIN ;if no more brothers, we are really done
HRLM A,DICT+2(DPTR) ;next brother now points back to the inserted word
HRRM DPTR,DICT+2(A) ;the inserted brother now points to the next brother
JRST WRITIN ;go make text entries
INSSON: HLRZ B,DICT+1(DPTR) ;B←last son of father,soon to be new brother
MOVE A,DCBOTM ;A←inserted son
ADDI A,3
MOVEM A,DCBOTM
HRLM A,DICT+1(DPTR) ;father now points to new son
HRRM B,DICT+2(A) ;new son now points to new brother(old son)
HRLM DPTR,DICT+2(A) ;new son now points back to father
JUMPE B,WRITIN ;if no new brother, we are done
HRLM A,DICT+2(B) ;new brother now points back to inserted new son
JRST WRITIN ;go make WORDS.INS entries
INS1SN: SUBI DBOT,2 ;get the last moved entry
HLRZ B,DICT2+1(DBOT) ;B←son of last father
MOVE A,DCBOTM ;A ← inserted word
ADDI A,3
MOVEM A,DCBOTM
HRLM A,DICT2+1(DBOT) ;father now points to new son
HRLM DBOT,DICT+2(A) ;new son now points to father
ADDI DBOT,2
HRRM B,DICT+2(A) ;as above
JUMPE B,WRITIN
HRLM A,DICT+2(B)
JRST WRITIN
WRITIN: MOVE C,A ;both C and A now point to the new word just insertedd
SETO B,
HRRM B,DICT+1(C) ;make it invalid
HRRZ B,WBPTR ;get the pointer into WORDS
SUBI B,WORDS-1
HRLM B,DICT(A) ;store it in the new word
WRITE2: MOVE PPTR,[POINT 7,PARTS,35]
ILDB CHAR,PPTR ;get a character from PARTS+1
MOVE INSPTR,INSPTM ;set up the byte pointer into WORDS.INS
CAIN CHAR,"@" ;end of word?
ERRMSG {TRYING TO INSERT WORD BEGINNING WITH @}
DPBYT2: HRRZ B,PPTR
SUBI B,PARTS
CAML B,LSTCNT ;up to this point is already in WORDS
IDPB CHAR,WBPTR ;deposit the char and continue
IDPB CHAR,INSPTR ;deposit into WORDS.INS
ILDB CHAR,PPTR ;get next char
CAIE CHAR,"@" ;is it an @?
JRST DPBYT2 ;no, continue
SKIPE STAINF ;don't want to put @'s in WORDS if it is a
JRST NXTAT ;stationary insert or if we havn't reached the
CAMGE B,LSTCNT ;point of any change in the DICT
JRST NXTAT
DP1002: IDPB CHAR,WBPTR ;yes,prepare to deposit @ signs
TLNE WBPTR,760000 ;finished with this word?
JRST DP1002 ;no
NXTAT: ILDB CHAR,PPTR ;eat up all the @'s
CAIN CHAR,"@"
JRST NXTAT
SKIPN STAINF
JRST NXTAT2
JUMPE CHAR,INSDUN ;finished
MOVEI B," " ;put the space in WORDS.INS
IDPB B,INSPTR
JRST DPBYT2 ;go back and deposit the next word
NXTAT2: JUMPE CHAR,INSDUN ;finished
MOVEM PPTR,STORAG ;save PPTR
MOVEI A," " ;put the space in WORDS.INS
IDPB A,INSPTR
MOVE PPTR,STORAG
CAMGE B,LSTCNT ;see if we have finished the identical part of
JRST DPBYT2 ;the new word
MOVE C,DCBOTM ;yes. an entry must be made
MOVE A,C ;A is the last inserted word
ADDI C,3 ;C is the new spot
HRLM A,DICT+2(C) ;WHAT IF A ISN'T RELATED TO C?
HRLM C,DICT+1(A) ;and A now points to C
SETO A,
HRRM A,DICT+1(C) ;make it invalid
HRRZ A,WBPTR ;put the pointer into WORDS in the new word
SUBI A,WORDS-1
HRLZM A,DICT(C)
MOVEM C,DCBOTM
MOVE PPTR,STORAG
JRST DPBYT2 ;go write out this word
INSDUN: SKIPN STAINF
HLLZS DICT+1(C) ;make this key valid
HRRZ A,WBPTR ;see if we've run out of room in WORDS
SUBI A,WORDS
CAIL A,WLEN
ERRMSG {WORDS IS TOO SMALL}
MOVEI CHAR,CR ;now put in CRLF
IDPB CHAR,INSPTR
MOVEI CHAR,LF
IDPB CHAR,INSPTR
MOVEM INSPTR,INSPTM ;save INSPTR in memory
SKIPE MOVED ;either MOVE the last entry or TEST3 it to see
JRST .+3 ;if the moved version is still valid
PUSHJ P,MOV
JRST .+2
PUSHJ P,TEST3
PUSHJ P,GETSRT ;get the next SORTED word
SETOM OLMLFG ;this is a MULT
SETZ RPTR,
SETZM STAINF
MOVEI CNT,1
JRST NXTMLT ;go back and compare the new word with the old DICT
GETMLT: MOVE WSORT,PARTS(CNT) ;SAVDIF expects this
SKIPN MULFLG ;no more MULTS..go delete something
JRST DELMUL
ADDI RPTR,1 ;increment the retrieval pointer
CAMG RPTR,KPTR ;see if it has passed KPTR
JRST NXTMLT ;no, go back and compare
JRST SAVDIF ;yes.The keys are different.
;CONTINUE BUILDING THE TABLE, INCLUDING THE MULTIPLE WORDS NOW
PREFIX: MOVE A,DICT(DPTR) ;move question mark
MOVEM A,DICT2(DBOT)
MOVE A,DICT+1(DPTR)
MOVEM A,DICT2+1(DBOT)
MOVEM DBOT,STORAG
MOVE A,DCBOTM ;set second word past last entry to ones
ADDI A,3
MOVEM A,DCBOTM
SETOM DICT(A)
SETOM DICT+1(A)
SKIPE OCFLG
JRST OC3
MOVE A,OCCUR(CPTR) ;move OCCUR.DAT's question mark
MOVE CBOT,CBOTM
MOVEM A,OCCUR2(CBOT)
OC3: MOVE RPTR,DBOT ;DBOT becomes the next record boundary..
ADDI DBOT,1 ;where the mults will go
ZERMLT: SETZM DICT2(DBOT)
TRNE DBOT,177
AOJA DBOT,ZERMLT
FIGDIF: MOVE MPTR,DPTR ;MPTR is set to the beginning of the the mults
ADDI MPTR,1 ;in DICT
ZERCNT: MOVE A,DICT(MPTR)
JUMPN A,MLCNDN
AOJA MPTR,ZERCNT
MLCNDN: MOVE RECDIF,DBOT ;we get the difference in the beginnings of the
SUB RECDIF,MPTR ;two areas for the mults
MOV1TM: MOVE LPTR,MPTR ;save MPTR
MOVE C,DBOT
ADDI C,=128 ;in order to insert words, the first move is
ADDI RECDIF,=128 ;to an area one record off from the correct position
MOVIT: MOVE A,DICT(MPTR) ;move all mults from DICT to DICT2, changing
JUMPE A,SKIPBL ;appropriate pointers by the RECDIF
MOVEM A,DICT2(C)
MOVE A,DICT+1(MPTR)
JUMPL A,PREMOV ;the end is marked with 7's
HLRZ A,DICT+1(MPTR)
JUMPE A,.+2
ADD A,RECDIF
HRLM A,DICT2+1(C) ;son pointer
HRRZ A,DICT+1(MPTR)
HRRM A,DICT2+1(C)
HLRZ A,DICT+2(MPTR) ;back pointer
JUMPE A,MOV5
CAML A,LPTR ;don't increment if not in MULTS
ADD A,RECDIF
MOV5: HRLM A,DICT2+2(C)
HRRZ A,DICT+2(MPTR)
JUMPE A,.+2
ADD A,RECDIF
HRRM A,DICT2+2(C)
ADDI MPTR,3
ADDI C,3
JRST MOVIT
SKIPBL: ADDI MPTR,1 ;skip the blank words before a new record
AOJA C,MOVIT
PREMOV: SETOM DICT2+1(C) ;set flag indicating end of MULTS
ADDI C,3 ;save end
MOVEM C,STOR2
SUBI RECDIF,=128 ;prepare to move MULTS into correct position
MOVE MPTR,LPTR
MOVNM MPTR,TABLE(TPTR);make TABLE entries
MOVEM RECDIF,TABLE+1(TPTR)
ADDI TPTR,2
MOVE DPTR,DBOT ;move words from DBOT to DPTR
ADDI DBOT,=128
MOVAGN: MOVE A,DICT2(DBOT) ;if -1, this entry was deleted. A table entry must be
JUMPLE A,TABENT ;made and the pointers incremented
MOVEM A,DICT2(DPTR)
HLRZ A,DICT2+1(DBOT) ;get son pointer
HRLM A,DICT2+1(DPTR)
CAML A,LPTR
HRLM DPTR,DICT2+2(A) ;if son is a MULT, correct the son backpointer
MCON1: HRRZ A,DICT2+1(DBOT) ;links pointer
HRRM A,DICT2+1(DPTR)
HLRZ A,DICT2+2(DBOT) ;backpointer
HRLM A,DICT2+2(DPTR)
CAMG A,LPTR
JRST MCON2
HLRZ B,DICT2+1(A) ;if backpointer points to a mult,see if it is pointed
CAMN DBOT,B ;to by the son or brother, and correct the correct pointer
JRST .+3
HRRM DPTR,DICT2+2(A)
JRST MCON2
HRLM DPTR,DICT2+1(A)
MCON2: HRRZ A,DICT2+2(DBOT) ;brother pointer
HRRM A,DICT2+2(DPTR)
CAML A,LPTR
HRLM DPTR,DICT2+2(A) ;if it points to a MULT, correct the backpointer
MCON3: ADDI DBOT,3 ;increment the pointers
ADDI MPTR,3
SETZ B,
ADDI DPTR,3 ;check to see if next entry will have a record boundary
MOVE A,DPTR
MCON4: TRNN A,177
JRST ADVNCE
ADDI A,1
ADDI B,1
TRNN A,177
JRST ADVNCE
ADDI A,1
ADDI B,1
TRNE A,177
JRST MOVAGN
ADVNCE: ADD RECDIF,B ;yes,so leave some unused slots, make a TABLE entry
MOVNM MPTR,TABLE(TPTR)
MOVEM RECDIF,TABLE+1(TPTR)
ADDI TPTR,2
MOVE DPTR,A
JRST MOVAGN
TABENT: MOVNM MPTR,TABLE(TPTR);make half of TABLE entry
SETZ B,
TAB2: JUMPE A,TAB3 ;if passing blanks, go to TAB3
;passing deleted words
TAB4: MOVE A,DICT+1(MPTR) ;see if this is the end of MULTS
JUMPL A,PRE2
ADDI B,3 ;no,increment pointers
ADDI DBOT,3
ADDI MPTR,3
MOVE A,DICT(MPTR) ;get next slot
JUMPL A,TAB4 ;also deleted
JUMPE A,TAB3 ;skipping blanks
TAB5: SUB RECDIF,B ;regular slot coming up. Update RECDIF
MOVEM RECDIF,TABLE+1(TPTR);make TABLE entry
ADDI TPTR,2
JRST MOVAGN
;skipping zeros
TAB3: ADDI B,1 ;increment past one blank word
ADDI DBOT,1 ;until we hit a record boundary
ADDI MPTR,1
TRNE DBOT,177
JRST TAB3
JRST TAB5
PRE2: SETZM DICT2(DPTR)
TRNE DPTR,177
AOJA DPTR,PRE2
PRE4: SUBI DPTR,1
TRC DPTR,777777
HRLM DPTR,D2CMD
MOVNM MPTR,TABLE(TPTR) ;make final TABLE entry
OPEN 11,DSK17
ERRMSG {OPEN FAILED ON DELETE}
SETZM DELF+2
SETZM DELF+3
ENTER 11,DELF
ERRMSG {ENTER FAILED ON WORDS.DEL}
OUT 11,DELCMD ;output WORDS.DEL
JRST .+2
ERRMSG {OUT FAILED ON WORDS.DEL}
RELEAS 11,
OPEN 12,DSK17
ERRMSG {OPEN FAILED ON WORDS.INS}
SETZM INSF+2
SETZM INSF+3
ENTER 12,INSF
ERRMSG {ENTER FAILED ON WORDS.INS}
OUT 12,INSCMD ;output WORDS.INS
JRST .+2
ERRMSG {OUT FAILED ON WORDS.INS}
RELEAS 12,
;FIXING THE LINKS AND DICT FILES
CHAND2: SETZ DPTR, ;now we change the pointers from DICT into MULTS
MOVE RPTR,STORAGE
CHAND3: ADDI DPTR,2
CAML DPTR,RPTR
JRST FIXLIN
HAND2: HLRZ A,DICT2+1(DPTR) ;get pointer into MULTS
JUMPE A,CHAND3 ;no pointer
MOVN C,A
SETZ TPTR,
CHAN3: CAMLE C,TABLE(TPTR) ;find correct TABLE entry
JRST FNDDN
ADDI TPTR,2
JRST CHAN3
FNDDN: MOVE B,TABLE-1(TPTR) ;increment the pointer by the accompanying DIFNO
ADD A,B
HRLM DPTR,DICT2+2(A) ;correct both pointers
HRLM A,DICT2+1(DPTR)
JRST CHAND3
FIXLIN: MOVEI LPTR,0 ;initialize links pointer
FIX2: ADDI LPTR,2 ;pointer to link
CAIL LPTR,LLEN ;if there is none, we're done
JRST UPNOTE ;EXCEPT FOR UPDATING THE AUTO. NOTIF. FILE
HRRE BPTR,LINKS(LPTR)
JUMPG BPTR,FIX2 ;if negative, we must change it
SETZ TPTR, ;prepare to search the TABLE
FINDIF: CAMLE BPTR,TABLE(TPTR);find first pointer in DICT that is greater
JRST FNDDNO ;found it
ADDI TPTR,2 ;keep looking
JRST FINDIF
FNDDNO: MOVE A,TABLE-1(TPTR) ;now get the number this must be altered
SUB BPTR,A ;change it
HRRM BPTR,LINKS(LPTR);store it
JRST FIX2 ;go back for more
;Now we update the automatic notification file's pointers into DICT
UPNOTE: INIT 13,10
SIXBIT /DSK/
NIBUF
ERRMSG {INIT FAILED ON DSK}
SETZM NOTIFF+3
LOOKUP 13,NOTIFF ;this is the auto notif file
JRST NONOTF
INIT 14,10
SIXBIT /DSK/
NOBUF,,0
ERRMSG {INIT FAILED ON DSK}
RENOTF: SETZM NOTIFF+1
SETZM NOTIFF+2
SETZM NOTIFF+3
ENTER 14,NOTIFF ;this is the new auto notif file
JRST [OUTSTR [ASCIZ /
ENTER failed on NOTIF.
Type 'CONTINUE' to try again./]
EXIT 1,
JRST RENOTF]
SETZ B,
UPN0: PUSHJ P,GNTF ;GET NEXT WORD FROM NOTIF
TLNN A,-1 ;IS LEFT HALF ZERO?
JRST UPN1 ;YES. MIGHT BE DICT PTR
UPN2: PUSHJ P,PNTF ;PUT THIS WORD INTO NEW NOTIF
MOVE B,A ; AND SAVE A COPY OF IT
JRST UPN0
UPN1: JUMPE A,UPN2 ;IF CURRENT WORD IS ZERO, IS NOT DICT PTR.
JUMPE B,UPN2 ;IF PREV WORD IS ZERO, DONT HAVE DICT PTR.
CAIE A,-1 ;IF CURRENT WORD IS 0,,-1, THEN NOT DICT PTR
CAMN B,[-1] ;IF PREV WORD IS -1, THEN NO DICT PTR
JRST UPN2
MOVN A,A ;WE'VE GOT A DICT PTR. ADJUST IT.
SETZ TPTR, ;INDEX INTO TABLE OF ADJUSTMENTS
UPN3: CAMLE A,TABLE(TPTR) ;FOUND RIGHT ENTRY IN TABLE YET?
JRST UPN4 ;YES
ADDI TPTR,2 ;NO
JRST UPN3
UPN4: SUB A,TABLE-1(TPTR) ;MAKE ADJUSTMENT
MOVN A,A ; AND THEN MAKE DICT PTR POSITIVE AGAIN
JRST UPN2 ; AND SAVE IT IN NEW NOTIF
NONOTF: HRRZ A,NOTIFF+3 ;GET ERROR CODE FROM LOOKUP
JUMPE A,DONE ;IF NOTIF DOESN'T EXIST, THEN NOTHING TO DO
OUTSTR [ASCIZ/
FILE NOT FOUND: NOTIF.
Type 'CONTINUE' to try again./]
EXIT 1,
JRST UPNOTE ;TRY AGAIN
GNTF: SOSG NIBUF+2 ;GET NEXT WORD FROM OLD NOTIF FILE
IN 13,
JRST [ILDB A,NIBUF+1
POPJ P,]
STATO 13,20000 ;EOF?
ERRMSG {INPUT ERROR FROM NOTIF} ;NO
UPN9: CAIE B,'EOF' ;WAS LAST WORD AN EOF MARKER?
ERRMSG {EOF IN NOTIF WITHOUT EOF MARKER} ;NO
RELEAS 13, ;CLOSE INPUT NOTIF FILE
JRST DONE ;OUTPUT NOTIF FILE CLOSED LAST
PNTF: SOSG NOBUF+2 ;PUT WORD INTO NEW NOTIF FILE
OUT 14,
JRST [IDPB A,NOBUF+1
POPJ P,]
ERRMSG {OUTPUT ERROR ON NOTIF FILE}
;CREATE THE TMP FILES
DONE: OPEN 5,DSK17
ERRMSG {SECOND OPEN FAILED ON DICT}
MOVEI A,'TMP'
HRLZM A,DICTF+1
SETZM DICTF+2
SETZM DICTF+3
ENTER 5,DICTF
ERRMSG {ENTER FAILED ON DICT}
SKIPE OCFLG
JRST OC4
OPEN 10,DSK17
ERRMSG {SECOND OPEN FAILED ON OCCUR.DAT}
MOVEI A,'TMP'
HRLZM A,OCCURF+1
SETZM OCCURF+2
SETZM OCCURF+3
ENTER 10,OCCURF
ERRMSG {ENTER FAILED ON OCCUR.DAT}
OC4: OPEN 7,DSK17
ERRMSG {SECOND OPEN FAILED ON WORDS}
MOVEI A,'TMP'
HRLZM A,WORDSF+1
SETZM WORDSF+2
SETZM WORDSF+3
ENTER 7,WORDSF
ERRMSG {ENTER FAILED ON WORDS}
OPEN 6,DSK17
ERRMSG {SECOND OPEN FAILED ON LINKS}
MOVEI A,'TMP'
HRLZM A,LINKSF+1
SETZM LINKSF+2
SETZM LINKSF+3
ENTER 6,LINKSF
ERRMSG {ENTER FAILED ON LINKS}
;WRITE OUT THE TMP FILES. ASK IF SHOULD CONTINUE
OUT 5,D2CMD
JRST .+2
ERRMSG {OUTPUT ERROR ON NEW DICT}
OUT 6,LCMD
JRST .+2
ERRMSG {OUTPUT ERROR ON NEW LINKS}
OUT 7,WCMD
JRST .+2
ERRMSG {OUTPUT ERROR ON NEW WORDS}
SKIPE OCFLG
JRST CON4
OUT 10,O2CMD
JRST .+2
ERRMSG {OUTPUT ERROR ON NEW OCCUR.DAT}
RELEAS 10,
CON4: RELEAS 7,
RELEAS 6,
RELEAS 5,
MOVE A,SPACES ;change LINCNT to ascii to output the
MOVE LINCNT,TOTCNM ;number of links that will be lost
IDIVI LINCNT,=10
ADDI LINCNT+1,60
TRZ A,40
ADDI A,(LINCNT+1)
JUMPE LINCNT,DONE3
ROT A,-7
IDIVI LINCNT,=10
ADDI LINCNT+1,60
TRZ A,40
ADDI A,(LINCNT+1)
JUMPE LINCNT,DONE0
ADDI LINCNT,60
ROT A,-7
TRZ A,40
ADDI A,(LINCNT)
DUN00: ROT A,7
DONE0: ROT A,7
DONE3: LSH A,1
OUTSTR [ASCIZ /
/]
MOVEM A,STRNG
OUTSTR STRNG
OUTSTR [ASCIZ / LINKS WILL BE LOST. SHOULD I CONTINUE? /]
INCHRW CHAR
CAIN CHAR,CR
INCHWL A ;READ THE LF AFTER THE CR
CAIE CHAR,"Y"
CAIN CHAR,"y"
JRST DELEM
JRST FINISH
;DELETE THE OLD FILES PRIOR TO RENAMING THE NEW ONES
DELEM: OPEN 6,DSK17
ERRMSG {OPEN FAILED ON LINKS}
SETZM LINKSF+1
SETZM LINKSF+3
LOOKUP 6,LINKSF
ERRMSG {LOOKUP FAILED ON LINKS PAGE 10}
RENAME 6,RENADR
ERRMSG {RENAME FAILED ON LINKS}
RELEAS 6,
OPEN 5,DSK17
ERRMSG {OPEN FAILED ON DICT}
SETZM DICTF+1
SETZM DICTF+3
LOOKUP 5,DICTF
ERRMSG {LOOKUP FAILED ON DICT PAGE 10}
RENAME 5,RENADR
ERRMSG {RENAME FAILED ON DICT}
RELEAS 5,
OPEN 7,DSK17
ERRMSG {OPEN FAILED ON WORDS}
SETZM WORDSF+1
SETZM WORDSF+3
LOOKUP 7,WORDSF
ERRMSG {LOOKUP FAILED ON WORDS PAGE 10}
RENAME 7,RENADR
ERRMSG {RENAME FAILED ON WORDS}
RELEAS 7,
SKIPE OCFLG
JRST FINCON
OPEN 10,DSK17
ERRMSG {OPEN FAILED ON OCCUR.DAT}
MOVEI A,'DAT'
HRLZM A,OCCURF+1
SETZM OCCURF+3
LOOKUP 10,OCCURF
ERRMSG {LOOKUP FAILED ON OCCUR.DAT PAGE 10}
RENAME 10,RENADR
ERRMSG {RENAME FAILED ON OCCUR.DAT}
RELEAS 10,
;RENAME THE TMP FILES TO STANDARD NAMES, THEN LEAVE.
OPEN 10,DSK17
ERRMSG {OPEN FAILED ON OCCUR.DAT}
MOVEI A,'TMP'
HRLZM A,OCCURF+1
SETZM OCCURF+3
LOOKUP 10,OCCURF
ERRMSG {LOOKUP FAILED ON OCCUR.TMP}
MOVEI A,'DAT'
HRLZM A,OCCURF+1
SETZM OCCURF+2
SETZM OCCURF+3
RENAME 10,OCCURF
ERRMSG {RENAME FAILED ON OCCUR.TMP}
RELEAS 10,
FINCON: OPEN 6,DSK17
ERRMSG {OPEN FAILED ON LINKS}
MOVEI A,'TMP'
HRLZM A,LINKSF+1
SETZM LINKSF+3
LOOKUP 6,LINKSF
ERRMSG {LOOKUP FAILED ON LINKS.TMP}
SETZM LINKSF+1
SETZM LINKSF+2
SETZM LINKSF+3
RENAME 6,LINKSF
ERRMSG {RENAME FAILED ON LINKS.TMP}
RELEAS 6,
OPEN 5,DSK17
ERRMSG {OPEN FAILED ON DICT}
MOVEI A,'TMP'
HRLZM A,DICTF+1
SETZM DICTF+3
LOOKUP 5,DICTF
ERRMSG {LOOKUP FAILED ON DICT.TMP}
SETZM DICTF+1
SETZM DICTF+2
SETZM DICTF+3
RENAME 5,DICTF
ERRMSG {RENAME FAILED ON DICT.TMP}
RELEAS 5,
OPEN 7,DSK17
ERRMSG {OPEN FAILED ON WPRDS}
MOVEI A,'TMP'
HRLZM A,WORDSF+1
SETZM WORDSF+3
LOOKUP 7,WORDSF
ERRMSG {LOOKUP FAILED ON WORDS.TMP}
SETZM WORDSF+1
SETZM WORDSF+2
SETZM WORDSF+3
RENAME 7,WORDSF
ERRMSG {RENAME FAILED ON WORDS.TMP}
RELEAS 7,
FINISH: RELEAS 14, ;NEW NOTIF FILE
RESET ;release the lock on AP files without screwing up INDEX
EXIT
;TEST3 MOV GETBYT ERROR
;see if DICT2 entry is still valid
TEST3: HLRZ A,DICT2-2(DBOT) ;compare the last WORD pointer with the WORD
HRRZ B,MULKY ;pointer of MULKY
HLRZ B,DICT(B)
CAME B,A
POPJ P, ;if not the same,forget it
MOVE B,MULKY ;move them just in case
MOVE A,DICT(B)
MOVEM A,DICT2-2(DBOT)
MOVE A,DICT+1(B)
MOVEM A,DICT2-1(DBOT)
POPJ P,
MOV: MOVE A,DICT(DPTR) ;transfer two words in DICT to DICT2
MOVEM A,DICT2(DBOT)
MOVE A,DICT+1(DPTR)
MOVEM A,DICT2+1(DBOT)
ADDI DBOT,2
SETOM MOVED
SETOM OLMLFG
POPJ P,
GETBYT: SOSG IBUF+2 ;number of bytes left to be read
IN 2, ;input
JRST [ILDB CHAR,IBUF+1 ;get a character
JUMPE CHAR,GETBYT ;get another if character is null
POPJ P,] ;return
STATO 2,20000
ERRMSG {INPUT ERROR FROM WORDS.SRT}
RELEAS 2,
MOVEI CHAR,"?" ;run out of input...insert a ?
LSH CHAR,=29 ;rotate it to the correct filed
MOVEM CHAR,PARTS+1 ;and move it to the parts
JRST NXTDCT
ERROR: OUTSTR [CRLFS: ASCIZ /
/]
OUTSTR (A)
OUTSTR CRLFS
MOVE A,SAVEDA
EXIT 1,
HALT .
;GETSRT
GETSRT: MOVEI MAXW,5
GET3: MOVE A,PARTS(MAXW) ;store the first 5 words of the last SORTED word
MOVEM A,OLPART(MAXW)
SOJG MAXW,GET3
MOVE PPTR,[POINT 7,PARTS,35]
MOVEI MAXW,=20 ;maximum word length
SNXTCH: PUSHJ P,GETBYT ;get a byte
CAIN CHAR,"@"
JRST ENDWRD ;end of a word
CAIN CHAR,CR
JRST FNDEND ;end of the entire MULT
IDPB CHAR,PPTR ;put the character in PARTS
SOJG MAXW,SNXTCH
FND4: PUSHJ P,GETBYT ;eat all the @'s from WORDS.SRT
CAIN CHAR,"@"
JRST ENDWRD
CAIE CHAR,CR
JRST FND4
FNDEND: PUSHJ P,GETBYT ;read until a LF appears
CAIE CHAR,LF
JRST FNDEND
MOVEI CHAR,"@"
FND3: IDPB CHAR,PPTR ;finish word with @'s
TLNE PPTR,760000
JRST FND3
IDPB CHAR,PPTR ;and make another word of @'s
IDPB CHAR,PPTR
IDPB CHAR,PPTR
IDPB CHAR,PPTR
IDPB CHAR,PPTR
MOVEI CHAR,0
IDPB CHAR,PPTR ;and then a null word
IDPB CHAR,PPTR
IDPB CHAR,PPTR
IDPB CHAR,PPTR
IDPB CHAR,PPTR
NUOUT: MOVEI MAXW,1
NUOUT2: MOVE CHAR,PARTS(MAXW) ;see if this has already been moved
CAME CHAR,OLPART(MAXW)
JRST OUT3
CAME CHAR,[ASCII /@@@@@/]
AOJA MAXW,NUOUT2
SETOM MOVED ;OLPART = first word. Set the flag
OUT4: POPJ P,
OUT3: SOJLE MAXW,OUT5
MOVE CHAR,PARTS(MAXW)
SETOM MOVED ;THIS INSTRUCTION MIGHT FIX A BUG
TRNE CHAR,176
OUT5: SETZM MOVED
POPJ P,
ENDWRD: IDPB CHAR,PPTR ;end of one of the words of the MULT
TLNE PPTR,760000 ;finish word with @'s
JRST ENDWRD
END2: IDPB CHAR,PPTR ;and make another word of @'s
TLNE PPTR,760000
JRST END2
MOVEI MAXW,=20
JRST SNXTCH
;COUNTL
COUNTL: MOVEI LINCNT,0 ;initialize the link count to zero
HRRE WPTR,DICT+1(DPTR);get the first link
JUMPLE WPTR,CNTDUN ;if zero we're done
CNTLIN: ADDI LINCNT,1 ;not zero. increment count
HLRZ A,LINKS(WPTR);get next link
SETZM LINKS+1(WPTR)
HRRZS LINKS(WPTR)
MOVE WPTR,A
JUMPG WPTR,CNTLIN ;if next pointer isn't zero, continue
CNTDUN: MOVE A,TOTCNM ;get the total count number
ADDI A,(LINCNT) ;add in this list
MOVEM A,TOTCNM ;move it back to memory
MOVEM KPTR,KPTRM
MOVE A,SPACES ;start to set up WORDS.DEL
TRZ A,40 ;get rid of last space in preparation for the tab
MOVEI LINCNT+1,11 ;tab
ADDI A,(LINCNT+1) ;add it into A
IDIVI LINCNT,=10 ;divide the link count by 10.LINCNT+1 holds the remainder
ADDI LINCNT+1,60 ;change it to ascii
ROT A,-7 ;rotate A to make room for digit
TRZ A,40 ;get rid of space
ADDI A,(LINCNT+1) ;add in the one's place
JUMPE LINCNT,CDUN3 ;if LINCNT=0 then we're done
ROT A,-7 ;rotate A around for next digit
IDIVI LINCNT,=10 ;etc.
ADDI LINCNT+1,60
TRZ A,40
ADDI A,(LINCNT+1)
JUMPE LINCNT,CDONE0
ADDI LINCNT,60
ROT A,-7
TRZ A,40
ADDI A,(LINCNT)
CDUN00: ROT A,7 ;rotate A back to correct position
CDONE0: ROT A,7
CDUN3: ROT A,7
LSH A,1 ;plus one for the last bit
MOVEM A,DEL(DELPTR) ;put in WORDS.DEL
ADDI DELPTR,1 ;add on to the pointer
MOVE KPTR,KPTRM
SETZ B,
NXTMWD: MOVE C,MULKY(B)
DEL6: HLRZ WPTR,DICT(C) ;get pointer to WORDS for the deleted word
DEL4: MOVE A,WORDS(WPTR) ;get first part
TRNE A,176 ;end in @?
JRST EXDUN ;no
TRNE A,37400 ;any more?
JRST DWRDUN ;no
TRZ A,40000 ;yes...get rid of next @ sign.
TDNE A,MASK ;more?
JRST DWRDUN ;etc.
TLZ A,10
TLNE DIFP,1760
JRST DWRDUN
TLZ A,2000
TLNN A,37400
TLZ A,400000
JRST DWRDUN
EXDUN: MOVEM A,DEL(DELPTR) ;move part into WORDS.DEL
ADDI DELPTR,1 ;increment pointers
AOJA WPTR,DEL4 ;return for next part
DWRDUN: MOVEM A,DEL(DELPTR) ;end of word. move into WORDS.DEL
ADDI DELPTR,1 ;increment pointers
ADDI B,1
CAMG B,KPTR
JRST NXTMWD
DUN2: MOVEI A,6424 ;move in CRLF
MOVEM A,DEL(DELPTR) ;store
ADDI DELPTR,1
MOVEM DELPTR,DELPTM ;save pointer into WORDS.DEL
POPJ P,
;GETDCT
GETDCT: SETZ RPTR, ;initialize the retrieval pointer
MOVE B,MULKY ;save the first 2 pointers
MOVEM B,OLMLKY
MOVE B,MULKY+1
MOVEM B,OLMLKY+1
GETDC2: JUMPLE KPTR,PLAINW ;if KPTR= 0 then we want a completely new word
MOVE C,MULKY(KPTR) ;otherwise get the current DPTR
HLRZ A,DICT+1(C) ;try to get it's son
JUMPN A,GOTML1
GETDC3: HRRZ C,DICT+2(C) ;try to get it's brother
JUMPN C,GOTML2
SOJLE KPTR,NOMOR ;can't..look at the father of this word
MOVE C,MULKY(KPTR)
JRST GETDC3
GOTML1: MOVE C,A
GOTML3: ADDI KPTR,1 ;make a new entry
GOTML2: MOVEM C,MULKY(KPTR) ;deposit the new entry
HRRE A,DICT+1(C) ;is this a stopping point?
JUMPGE A,CPOPJ ;yes
HLRZ C,DICT+1(C) ;no..get the son
JRST GOTML3 ;and deposit him
NOMOR: SETZM MOVED ;done with that MULT
SETOM OLMLFG
JRST NXTONE
PLAINW: JUMPL KPTR,NXTONE
MOVE C,MULKY
HLRZ C,DICT+1(C) ;try to get a son
JUMPN C,GETNXT
NXTONE: SETZ KPTR, ;no son
MOVEI C,2 ;increment the DICT pointer
ADDB C,MULKY
JRST GETNX2
GETNX3: HLRZ C,DICT+1(C) ;get the son
GETNXT: ADDI KPTR,1 ;increment KPTR
MOVEM C,MULKY(KPTR) ;deposit the son
GETNX2: HRRE A,DICT+1(C) ;is it a valid stopping point?
JUMPL A,GETNX3 ;IF NOT, GET ANOTHER SON
CPOPJ: POPJ P,
END MODIFY